

# Script "Consumers Are Willing to Pay a Price for Explainable, But Not for Green AI. Evidence from a Choice-Based Conjoint Analysis"

# Script for generating conjoint choice sets

# Version: 9 November 2021



library(conjoint)
library(grid)
library(gridExtra)



#### Step 1: Create orthogonal design and full choice set matrix #####

# declare features and their levels
experiment<-expand.grid(Nutzen =  c("A",
                                       "B",
                                       "C"),
                        Transparenz =  c("A",
                                              "B",
                                              "C"),
                        Kosten =  c("A",
                                  "B",
                                  "C"),
                        Energie =  c("A",
                          "B",
                          "C"))

# create orthogonal design
design1=caFactorialDesign(data=experiment, 
                         type = "orthogonal")
print(design1)
print(cor(caEncodedDesign(design1)))


# produce alternatives via shifting

design1 <- data.frame(lapply(design1, 
                              function(x) 
                                as.numeric(x))) # make values numeric first

design2 <- design1
design2[design1 == 1] <- 2
design2[design1 == 2] <- 3
design2[design1 == 3] <- 1
  
design3 <- design2
design3[design2 == 1] <- 2
design3[design2 == 2] <- 3
design3[design2 == 3] <- 1



# combine the designs to get choice sets

fulldesign <- cbind(design1, design2, design3)


fulldesign_long <- data.frame() # create design in long format
for (i in 1: nrow(design1)){
  tmp <- data.frame(choice = i, 
                    stimulus = 1:4, 
                    rbind(design1[i, ], design2[i,], design3[i ,], rep(0, 5) ) # repeat 0 for no choice and 5 times for 5 variables
  )
  
  fulldesign_long <- rbind(fulldesign_long, tmp)
  
}





#### Step 2: Generate choice cards ####

# define factors for creating choice cards


## Design 1 (first option in choice sets)

design1$Nutzen <- factor(design1$Nutzen,
                           levels = c(1,2,3),
                         labels = c("89 Prozent \n zufrieden",
                                    "94 Prozent \n zufrieden",
                                    "99 Prozent \n zufrieden"))



design1$Transparenz <- factor(design1$Transparenz,
                        levels = c(1,2,3),
                        labels = c("Keine: Nur Anbieter hat\nEinsicht in das System.",
                                   "Gering: Generelle Funktions-\nweise ist offengelegt.",
                                   "Hoch: Anwendung liefert Erkl�rung\nen f�r erhaltene Empfehlungen."))



design1$Kosten <- factor(design1$Kosten,
                         levels = c(1,2,3),
                         labels = c("kostenlos",
                                    "1,99 Euro / Monat",
                                    "3,99 Euro / Monat"))


design1$Energie <-  factor(design1$Energie,
                           levels = c(1,2,3),
                           labels = c("= 1 Std. Laufzeit\nEnergiesparlampe.",
                                      "= 3 Std. Laufzeit\nEnergiesparlampe.",
                                      "= 5 Std. Laufzeit\nEnergiesparlampe."))


## Design 2 (second option in choice sets)

design2$Nutzen <- factor(design2$Nutzen,
                         levels = c(1,2,3),
                         labels = c("89 Prozent \n zufrieden",
                                    "94 Prozent \n zufrieden",
                                    "99 Prozent \n zufrieden"))


design2$Transparenz <- factor(design2$Transparenz,
                              levels = c(1,2,3),
                              labels = c("Keine: Nur Anbieter hat\nEinsicht in das System.",
                                         "Gering: Generelle Funktions-\nweise ist offengelegt.",
                                         "Hoch: Anwendung liefert Erkl�rung-\nen f�r erhaltene Empfehlungen."))


design2$Kosten <- factor(design2$Kosten,
                         levels = c(1,2,3),
                         labels = c("kostenlos",
                                    "1,99 Euro / Monat",
                                    "3,99 Euro / Monat"))


design2$Energie <-  factor(design2$Energie,
                           levels = c(1,2,3),
                           labels = c("= 1 Std. Laufzeit\nEnergiesparlampe.",
                                      "= 3 Std. Laufzeit\nEnergiesparlampe.",
                                      "= 5 Std. Laufzeit\nEnergiesparlampe."))



## Design 3 (third option in choice sets)

design3$Nutzen <- factor(design3$Nutzen,
                         levels = c(1,2,3),
                         labels = c("89 Prozent \n zufrieden",
                                    "94 Prozent \n zufrieden",
                                    "99 Prozent \n zufrieden"))



design3$Transparenz <- factor(design3$Transparenz,
                              levels = c(1,2,3),
                              labels = c("Keine: Nur Anbieter hat\nEinsicht in das System.",
                                         "Gering: Generelle Funktions-\nweise ist offengelegt.",
                                         "Hoch: Anwendung liefert Erkl�rung-\nen f�r erhaltene Empfehlungen."))

design3$Kosten <- factor(design3$Kosten,
                         levels = c(1,2,3),
                         labels = c("kostenlos",
                                    "1,99 Euro / Monat",
                                    "3,99 Euro / Monat"))



design3$Energie <-  factor(design3$Energie,
                           levels = c(1,2,3),
                           labels = c("= 1 Std. Laufzeit\nEnergiesparlampe.",
                                      "= 3 Std. Laufzeit\nEnergiesparlampe.",
                                      "= 5 Std. Laufzeit\nEnergiesparlampe."))





#### Step 3: Create choice set tables that are the choice cards ####

# example for first card

attr <- c("Nutzerzufriedenheit\nmit Antworten", 
          "Transparenz", 
          "Preis",
          "CO2-Emissionen durch\nexternen Energieverbrauch\npro 10 Anfragen")


choice_tab <- data.frame(cbind(attr,
                               t(design1[5, ]),
                               t(design2[5, ]),
                               t(design3[5, ]))
                               ) 

colnames(choice_tab) <- c(" ",
                          "Variante A", 
                          "Variante B",
                          "Variante C")


# grid.table(choice_tab, theme = mytheme)

g <- tableGrob(choice_tab,
               cols = colnames(choice_tab), 
               rows = NULL,
               theme = ttheme_default(base_size = 12, 
                                      core = list(fg_params = list(hjust=c(rep(0,4), rep(0.5,4), rep(0.5,4), rep(0.5,4)), 
                                                                   x=c(rep(0.1,4), rep(0.5,4), rep(0.5,4), rep(0.5,4)), 
                                                                   fontsize=9),
                                                  bg_params = list(fill = c("grey80", "grey80", "grey80", "grey80",   # first column
                                                                            "grey95", "grey90", "grey95", "grey90",   # second column
                                                                            "grey95", "grey90", "grey95", "grey90",   # third column
                                                                            "grey95", "grey90", "grey95", "grey90") ) # fourth column
                                                  
                                      ), # end core params
                                      colhead = list(bg_params=list(fill = "lightskyblue1"),
                                                     fg_params=list(fontsize = 10))
               ) # end theme
)# end tableGrob



g$widths <- unit(c(0.25, 0.25, 0.25, 0.25), "npc")

grid.draw(g)




# Test image

# png(paste0("Choice cards/test.png"), width=20, height=5,units="cm", res=400)

grid.draw(g)

# dev.off()





#### Step 4: Loop for creating all choice set cards (this will write image files) ####

for (i in 1:nrow(design1)) {
  
  print(paste("Generating choice set: ", i))
  
  
  
  attr <- c("Nutzerzufriedenheit\nmit Antworten", 
            "Transparenz", 
            "Preis",
            "CO2-Emissionen durch\nexternen Energieverbrauch\npro 10 Anfragen")
  
  
  
  
  choice_tab <- data.frame(cbind(attr,
                                 t(design1[i, ]),
                                 t(design2[i, ]),
                                 t(design3[i, ]) )
  ) 
  
  
  colnames(choice_tab) <- c(" ",
                            "Variante A", 
                            "Variante B",
                            "Variante C")
  
  
  
  png(paste0("choice cards/choice_setA", i, ".png"), width=20, height=5,units="cm", res=400)
  
  g <- tableGrob(choice_tab,
                 cols = colnames(choice_tab), 
                 rows = NULL,
                 theme = ttheme_default(base_size = 12, 
                                        core = list(fg_params = list(hjust=c(rep(0,4), rep(0.5,4), rep(0.5,4), rep(0.5,4)), 
                                                                     x=c(rep(0.1,4), rep(0.5,4), rep(0.5,4), rep(0.5,4)), 
                                                                     fontsize=8),
                                                    bg_params = list(fill = c("grey80", "grey80", "grey80", "grey80",   # first column
                                                                              "grey95", "grey90", "grey95", "grey90",   # second column
                                                                              "grey95", "grey90", "grey95", "grey90",   # third column
                                                                              "grey95", "grey90", "grey95", "grey90") ) # fourth column
                                                    
                                        ), # end core params
                                        colhead = list(bg_params=list(fill = "lightskyblue1"),
                                                       fg_params=list(fontsize = 10))
                 ) # end theme
  )# end tableGrob
  
  
  
  g$widths <- unit(c(0.25, 0.25, 0.25, 0.25), "npc")
  
  grid.draw(g)
  
  
  dev.off()
  
}
 
